home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_emacs.idb / usr / freeware / share / emacs / 19.34 / lisp / viper-mous.el.z / viper-mous.el
Encoding:
Text File  |  1998-10-28  |  16.6 KB  |  458 lines
  1. ;;; viper-mous.el --- mouse support for Viper
  2.  
  3. ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ;; GNU General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  19. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20. ;; Boston, MA 02111-1307, USA.
  21.  
  22. ;; Code
  23.  
  24. (require 'viper-util)
  25.  
  26. ;; compiler pacifier
  27. (defvar double-click-time)
  28. (defvar mouse-track-multi-click-time)
  29. ;; end compiler pacifier
  30.  
  31.  
  32. ;;; Variables
  33.   
  34. ;; Variable used for catching the switch-frame event.
  35. ;; If non-nil, indicates that previous-frame should be the selected
  36. ;; one. Used by vip-mouse-click-get-word. Not a user option.
  37. (defvar vip-frame-of-focus nil)
  38.     
  39. ;; Frame that was selected before the switch-frame event.
  40. (defconst vip-current-frame-saved (selected-frame))
  41.   
  42. (defvar vip-surrounding-word-function 'vip-surrounding-word
  43.   "*Function that determines what constitutes a word for clicking events.
  44. Takes two parameters: a COUNT, indicating how many words to return, 
  45. and CLICK-COUNT, telling whether this is the first click, a double-click,
  46. or a tripple-click.")
  47.        
  48. ;; time interval in millisecond within which successive clicks are
  49. ;; considered related
  50. (defconst vip-multiclick-timeout (if vip-xemacs-p
  51.                      mouse-track-multi-click-time
  52.                    double-click-time)
  53.   "*Time interval in millisecond within which successive clicks are
  54. considered related.")
  55.  
  56. ;; current event click count; XEmacs only
  57. (defvar vip-current-click-count 0)
  58. ;; time stamp of the last click event; XEmacs only
  59. (defvar vip-last-click-event-timestamp 0)
  60.  
  61. ;; Local variable used to toggle wraparound search on click.
  62. (vip-deflocalvar  vip-mouse-click-search-noerror t)
  63.     
  64. ;; Local variable used to delimit search after wraparound.
  65. (vip-deflocalvar  vip-mouse-click-search-limit nil)
  66.     
  67. ;; remembers prefix argument to pass along to commands invoked by second
  68. ;; click.
  69. ;; This is needed because in Emacs (not XEmacs), assigning to preix-arg
  70. ;; causes Emacs to count the second click as if it was a single click
  71. (defvar vip-global-prefix-argument nil)
  72.  
  73.  
  74.  
  75. ;;; Code
  76.  
  77. (defsubst vip-multiclick-p ()
  78.   (not (vip-sit-for-short vip-multiclick-timeout t)))
  79.  
  80. ;; Returns window where click occurs
  81. (defsubst vip-mouse-click-window (click)
  82.   (if vip-xemacs-p
  83.       (event-window click)
  84.     (posn-window (event-start click))))
  85.  
  86. ;; Returns window where click occurs
  87. (defsubst vip-mouse-click-frame (click)
  88.   (window-frame (vip-mouse-click-window click)))
  89.  
  90. ;; Returns the buffer of the window where click occurs
  91. (defsubst vip-mouse-click-window-buffer (click)
  92.   (window-buffer (vip-mouse-click-window click)))
  93.  
  94. ;; Returns the name of the buffer in the window where click occurs
  95. (defsubst vip-mouse-click-window-buffer-name (click)
  96.   (buffer-name (vip-mouse-click-window-buffer click)))
  97.  
  98. ;; Returns position of a click
  99. (defsubst vip-mouse-click-posn (click)
  100.   (if vip-xemacs-p
  101.       (event-point click)
  102.     (posn-point (event-start click))))
  103.          
  104.  
  105. (defun vip-surrounding-word (count click-count)
  106.    "Returns word surrounding point according to a heuristic.
  107. COUNT indicates how many regions to return.
  108. If CLICK-COUNT is 1, `word' is a word in Vi sense.
  109. If CLICK-COUNT is 2,then `word' is a Word in Vi sense.
  110. If the character clicked on is a non-separator and is non-alphanumeric but
  111. is adjacent to an alphanumeric symbol, then it is considered alphanumeric
  112. for the purpose of this command. If this character has a matching
  113. character, such as `\(' is a match for `\)', then the matching character is
  114. also considered alphanumeric.
  115. For convenience, in Lisp modes, `-' is considered alphanumeric.
  116.  
  117. If CLICK-COUNT is 3 or more, returns the line clicked on with leading and
  118. trailing space and tabs removed. In that case, the first argument, COUNT,
  119. is ignored."
  120.    (let ((modifiers "")
  121.      beg skip-flag result
  122.      word-beg)
  123.      (if (> click-count 2)
  124.      (save-excursion
  125.        (beginning-of-line)
  126.        (vip-skip-all-separators-forward 'within-line)
  127.        (setq beg (point))
  128.        (end-of-line)
  129.        (setq result (buffer-substring beg (point))))
  130.        
  131.        (if (and (not (vip-looking-at-alphasep))
  132.         (or (save-excursion (vip-backward-char-carefully)
  133.                     (vip-looking-at-alpha))
  134.             (save-excursion (vip-forward-char-carefully)
  135.                     (vip-looking-at-alpha))))
  136.        (setq modifiers
  137.          (cond ((looking-at "\\\\") "\\\\")
  138.                ((looking-at "-") "C-C-")
  139.                ((looking-at "[][]") "][")
  140.                ((looking-at "[()]") ")(")
  141.                ((looking-at "[{}]") "{}")
  142.                ((looking-at "[<>]") "<>")
  143.                ((looking-at "[`']") "`'")
  144.                ((looking-at "\\^") "\\^")
  145.                ((vip-looking-at-separator) "")
  146.                (t (char-to-string (following-char))))
  147.          ))
  148.        
  149.        ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp
  150.        (or (looking-at "-")
  151.        (not (string-match "lisp" (symbol-name major-mode)))
  152.        (setq modifiers (concat modifiers "C-C-")))
  153.        
  154.        
  155.        (save-excursion
  156.      (cond ((> click-count 1) (vip-skip-nonseparators 'backward))
  157.            ((vip-looking-at-alpha modifiers)
  158.         (vip-skip-alpha-backward modifiers))
  159.            ((not (vip-looking-at-alphasep modifiers))
  160.         (vip-skip-nonalphasep-backward))
  161.            (t (if (> click-count 1)
  162.               (vip-skip-nonseparators 'backward)
  163.             (vip-skip-alpha-backward modifiers))))
  164.  
  165.      (setq word-beg (point))
  166.      
  167.      (setq skip-flag nil) ; don't move 1 char forw the first time
  168.      (while (> count 0)
  169.        (if skip-flag (vip-forward-char-carefully 1))
  170.        (setq skip-flag t) ; now always move 1 char forward
  171.        (if (> click-count 1)
  172.            (vip-skip-nonseparators 'forward)
  173.          (vip-skip-alpha-forward modifiers))
  174.        (setq count (1- count)))
  175.  
  176.      (setq result (buffer-substring word-beg (point))))
  177.        ) ; if
  178.      ;; XEmacs doesn't have set-text-properties, but there buffer-substring
  179.      ;; doesn't return properties together with the string, so it's not needed.
  180.      (if vip-emacs-p
  181.      (set-text-properties 0 (length result) nil result))
  182.      result
  183.      ))
  184.  
  185.  
  186. (defun vip-mouse-click-get-word (click count click-count)
  187.   "Returns word surrounding the position of a mouse click.
  188. Click may be in another window. Current window and buffer isn't changed.
  189. On single or double click, returns the word as determined by
  190. `vip-surrounding-word-function'."
  191.      
  192.   (let ((click-word "")
  193.     (click-pos (vip-mouse-click-posn click))
  194.     (click-buf (vip-mouse-click-window-buffer click)))
  195.     (or (natnump count) (setq count 1))
  196.     (or (natnump click-count) (setq click-count 1))
  197.      
  198.     (save-excursion
  199.       (save-window-excursion
  200.     (if click-pos
  201.         (progn
  202.           (set-buffer click-buf)
  203.     
  204.           (goto-char click-pos)
  205.           (setq click-word
  206.             (funcall vip-surrounding-word-function count click-count)))
  207.       (error "Click must be over a window."))
  208.     click-word))))
  209.  
  210.  
  211. (defun vip-mouse-click-insert-word (click arg)
  212.   "Insert word clicked or double-clicked on.
  213. With prefix argument, N, insert that many words.
  214. This command must be bound to a mouse click.
  215. The double-click action of the same mouse button must not be bound
  216. \(or it must be bound to the same function\).
  217. See `vip-surrounding-word' for the definition of a word in this case."
  218.   (interactive "e\nP")
  219.   (if vip-frame-of-focus    ;; to handle clicks in another frame
  220.       (select-frame vip-frame-of-focus))
  221.       
  222.   ;; turn arg into a number
  223.   (cond ((integerp arg) nil)
  224.     ;; prefix arg is a list when one hits C-u then command
  225.     ((and (listp arg) (integerp (car arg)))
  226.      (setq arg (car arg)))
  227.     (t (setq arg 1)))
  228.       
  229.   (let (click-count interrupting-event)
  230.     (if (and
  231.      (vip-multiclick-p)
  232.      ;; This trick checks if there is a pending mouse event
  233.      ;; if so, we use this latter event and discard the current mouse click
  234.      ;; If the next pending event is not a mouse event, we execute
  235.      ;; the current mouse event
  236.      (progn
  237.        (setq interrupting-event (vip-read-event))
  238.        (vip-mouse-event-p last-input-event)))
  239.     (progn ;; interrupted wait
  240.       (setq vip-global-prefix-argument arg)
  241.       ;; count this click for XEmacs
  242.       (vip-event-click-count click))
  243.       ;; uninterrupted wait or the interrupting event wasn't a mouse event
  244.       (setq click-count (vip-event-click-count click))
  245.       (if (> click-count 1)
  246.       (setq arg vip-global-prefix-argument
  247.         vip-global-prefix-argument nil))
  248.       (insert (vip-mouse-click-get-word click arg click-count))
  249.       (if (and interrupting-event
  250.            (eventp interrupting-event)
  251.            (not (vip-mouse-event-p interrupting-event)))
  252.       (vip-set-unread-command-events interrupting-event))
  253.       )))
  254.   
  255. ;; arg is an event. accepts symbols and numbers, too
  256. (defun vip-mouse-event-p (event)
  257.   (if (eventp event)
  258.       (string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
  259.             (prin1-to-string (vip-event-key event)))))
  260.   
  261. ;; XEmacs has no double-click events. So, we must simulate.
  262. ;; So, we have to simulate event-click-count.
  263. (defun vip-event-click-count (click)
  264.   (if vip-xemacs-p
  265.       (progn
  266.     ;; if more than 1 second
  267.     (if (> (- (event-timestamp click) vip-last-click-event-timestamp)
  268.            vip-multiclick-timeout)
  269.         (setq vip-current-click-count 0))
  270.     (setq vip-last-click-event-timestamp (event-timestamp click)
  271.           vip-current-click-count (1+ vip-current-click-count)))
  272.     (event-click-count click)))
  273.     
  274.  
  275.  
  276. (defun vip-mouse-click-search-word (click arg)
  277.    "Find the word clicked or double-clicked on. Word may be in another window.
  278. With prefix argument, N, search for N-th occurrence.
  279. This command must be bound to a mouse click. The double-click action of the
  280. same button must not be bound \(or it must be bound to the same function\).
  281. See `vip-surrounding-word' for the details on what constitutes a word for
  282. this command."
  283.   (interactive "e\nP")
  284.   (if vip-frame-of-focus    ;; to handle clicks in another frame
  285.       (select-frame vip-frame-of-focus))
  286.   (let (click-word click-count
  287.     (previous-search-string vip-s-string))
  288.     
  289.     (if (and
  290.      (vip-multiclick-p)
  291.      ;; This trick checks if there is a pending mouse event
  292.      ;; if so, we use this latter event and discard the current mouse click
  293.      ;; If the next pending event is not a mouse event, we execute
  294.      ;; the current mouse event
  295.      (progn
  296.        (vip-read-event)
  297.        (vip-mouse-event-p last-input-event)))
  298.     (progn ;; interrupted wait
  299.       (setq vip-global-prefix-argument 
  300.         (or vip-global-prefix-argument arg))
  301.       ;; remember command that was before the multiclick
  302.       (setq this-command last-command)
  303.       ;; make sure we counted this event---needed for XEmacs only
  304.       (vip-event-click-count click))
  305.       ;; uninterrupted wait
  306.       (setq click-count (vip-event-click-count click))
  307.       (setq click-word (vip-mouse-click-get-word click nil click-count))
  308.     
  309.       (if (> click-count 1)
  310.       (setq arg vip-global-prefix-argument
  311.         vip-global-prefix-argument nil))
  312.       (setq arg (or arg 1))
  313.     
  314.       (vip-deactivate-mark)
  315.       (if (or (not (string= click-word vip-s-string))
  316.           (not (markerp vip-search-start-marker))
  317.           (not (equal (marker-buffer vip-search-start-marker)
  318.               (current-buffer)))
  319.           (not (eq last-command 'vip-mouse-click-search-word)))
  320.       (progn
  321.         (setq  vip-search-start-marker (point-marker)
  322.            vip-local-search-start-marker vip-search-start-marker
  323.            vip-mouse-click-search-noerror t
  324.            vip-mouse-click-search-limit nil)
  325.         
  326.         ;; make search string known to Viper
  327.         (setq vip-s-string (if vip-re-search
  328.                    (regexp-quote click-word)
  329.                  click-word))
  330.         (if (not (string= vip-s-string (car vip-search-history)))
  331.         (setq vip-search-history
  332.               (cons vip-s-string vip-search-history)))
  333.         ))
  334.       
  335.       (push-mark nil t)
  336.       (while (> arg 0)
  337.     (vip-forward-word 1)
  338.     (condition-case nil
  339.         (progn
  340.           (if (not (search-forward click-word vip-mouse-click-search-limit
  341.                        vip-mouse-click-search-noerror))
  342.           (progn
  343.             (setq vip-mouse-click-search-noerror nil)
  344.             (setq vip-mouse-click-search-limit
  345.               (save-excursion
  346.                 (if (and
  347.                  (markerp vip-local-search-start-marker)
  348.                  (marker-buffer vip-local-search-start-marker))
  349.                 (goto-char vip-local-search-start-marker))
  350.                 (vip-line-pos 'end)))
  351.                 
  352.             (goto-char (point-min))
  353.             (search-forward click-word
  354.                     vip-mouse-click-search-limit nil)))
  355.           (goto-char (match-beginning 0))
  356.           (message "Searching for: %s" vip-s-string)
  357.           (if (<= arg 1)
  358.           (vip-flash-search-pattern))
  359.           )
  360.       (error (beep 1)
  361.          (if (or (not (string= click-word previous-search-string))
  362.              (not (eq  last-command 'vip-mouse-click-search-word)))
  363.              (message "`%s': String not found in %s"
  364.                   vip-s-string (buffer-name (current-buffer)))
  365.            (message
  366.             "`%s': Last occurrence in %s. Back to beginning of search"
  367.             click-word (buffer-name (current-buffer)))
  368.            (setq arg 1) ;; to terminate the loop
  369.            (sit-for 2))
  370.          (setq  vip-mouse-click-search-noerror t) 
  371.          (setq  vip-mouse-click-search-limit nil)
  372.          (if (and (markerp vip-local-search-start-marker)
  373.               (marker-buffer vip-local-search-start-marker))
  374.              (goto-char vip-local-search-start-marker))))
  375.     (setq arg (1- arg)))
  376.       )))
  377.   
  378. (defun vip-mouse-catch-frame-switch (event arg)
  379.   "Catch the event of switching frame.
  380. Usually is bound to a 'down-mouse' event to work properly. See sample
  381. bindings in viper.el and in the Viper manual."
  382.   (interactive "e\nP")
  383.   (setq vip-frame-of-focus nil)
  384.   ;; pass prefix arg along to vip-mouse-click-search/insert-word
  385.   (setq prefix-arg arg)
  386.   (if (eq last-command 'handle-switch-frame)
  387.       (setq vip-frame-of-focus vip-current-frame-saved))
  388.   ;; make Emacs forget that it executed vip-mouse-catch-frame-switch
  389.   (setq this-command last-command))
  390.       
  391. ;; Called just before switching frames. Saves the old selected frame.
  392. ;; Sets last-command to handle-switch-frame (this is done automatically in
  393. ;; Emacs. 
  394. ;; The semantics of switching frames is different in Emacs and XEmacs.
  395. ;; In Emacs, if you select-frame A while mouse is over frame B and then
  396. ;; start typing, input goes to frame B, which becomes selected.
  397. ;; In XEmacs, input will go to frame A. This may be a bug in one of the
  398. ;; Emacsen, but also may be a design decision.
  399. ;; Also, in Emacs sending input to frame B generates handle-switch-frame
  400. ;; event, while in XEmacs it doesn't.
  401. ;; All this accounts for the difference in the behavior of
  402. ;; vip-mouse-click-* commands when you click in a frame other than the one
  403. ;; that was the last to receive input. In Emacs, focus will be in frame A
  404. ;; until you do something other than vip-mouse-click-* command.
  405. ;; In XEmacs, you have to manually select frame B (with the mouse click) in
  406. ;; order to shift focus to frame B.
  407. (defsubst vip-remember-current-frame (frame)
  408.   (setq last-command 'handle-switch-frame
  409.     vip-current-frame-saved (selected-frame)))
  410.  
  411.  
  412. (cond ((vip-window-display-p)
  413.        (let* ((search-key (if vip-xemacs-p
  414.                   [(meta shift button1up)] [M-S-mouse-1]))
  415.           (search-key-catch (if vip-xemacs-p
  416.                     [(meta shift button1)] [M-S-down-mouse-1]))
  417.           (insert-key (if vip-xemacs-p
  418.                   [(meta shift button2up)] [M-S-mouse-2]))
  419.           (insert-key-catch (if vip-xemacs-p
  420.                     [(meta shift button2)] [M-S-down-mouse-2]))
  421.           (search-key-unbound (and (not (key-binding search-key))
  422.                        (not (key-binding search-key-catch))))
  423.           (insert-key-unbound (and (not (key-binding insert-key))
  424.                        (not (key-binding insert-key-catch))))
  425.           )
  426.          
  427.      (if search-key-unbound
  428.          (global-set-key search-key 'vip-mouse-click-search-word))
  429.      (if insert-key-unbound
  430.          (global-set-key insert-key 'vip-mouse-click-insert-word))
  431.     
  432.      ;; The following would be needed if you want to use the above two
  433.      ;; while clicking in another frame. If you only want to use them
  434.      ;; by clicking in another window, not frame, the bindings below
  435.      ;; aren't necessary.
  436.      
  437.      ;; These must be bound to mouse-down event for the same mouse
  438.      ;; buttons as 'vip-mouse-click-search-word and
  439.      ;; 'vip-mouse-click-insert-word
  440.      (if search-key-unbound
  441.          (global-set-key search-key-catch   'vip-mouse-catch-frame-switch))
  442.      (if insert-key-unbound
  443.          (global-set-key insert-key-catch   'vip-mouse-catch-frame-switch))
  444.      
  445.      (if vip-xemacs-p
  446.          (add-hook 'mouse-leave-frame-hook
  447.                'vip-remember-current-frame)
  448.        (defadvice handle-switch-frame (before vip-frame-advice activate)
  449.          "Remember the selected frame before the switch-frame event." 
  450.          (vip-remember-current-frame (selected-frame))))
  451.        )))
  452.  
  453.  
  454.  
  455. (provide 'viper-mous)
  456.  
  457. ;;;  viper-mous.el ends here
  458.